home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / xlisp2.1 / xldist02.zoo / sources / xlimage.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-11-09  |  8.8 KB  |  424 lines
  1. /* xlimage - xlisp memory image save/restore functions */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.         All Rights Reserved
  4.         Permission is granted for unrestricted non-commercial use    */
  5. /* modified so that offset is in sizeof(node) units */
  6. #include "xlisp.h"
  7. #include <string.h>
  8. #include <stdlib.h>
  9.  
  10. #ifdef SAVERESTORE
  11.  
  12. /* external variables */
  13. extern LVAL obarray,xlenv,xlfenv,xldenv,s_gchook,s_gcflag;
  14. extern long nnodes,nfree,total;
  15. extern int anodes,nsegs,gccalls;
  16. extern struct segment *segs,*lastseg,*fixseg,*charseg;
  17. extern CONTEXT *xlcontext;
  18. extern LVAL fnodes;
  19.  
  20. /* local variables */
  21. static OFFTYPE off,foff;
  22. static FILE *fp;
  23.  
  24. /* forward declarations */
  25. #ifdef ANSI
  26. OFFTYPE readptr(void);
  27. OFFTYPE cvoptr(LVAL p);
  28. LVAL cviptr(OFFTYPE o);
  29. void freeimage(void);
  30. void setoffset(void);
  31. void writenode(LVAL node);
  32. void writeptr(OFFTYPE off);
  33. void readnode(int type, LVAL node);
  34. #else
  35. OFFTYPE readptr();
  36. OFFTYPE cvoptr();
  37. LVAL cviptr();
  38. VOID freeimage();
  39. VOID setoffset();
  40. VOID writenode();
  41. VOID writeptr();
  42. VOID readnode();
  43. #endif
  44.  
  45. /* xlisave - save the memory image */
  46. int xlisave(fname)
  47.   char *fname;
  48. {
  49.     char fullname[STRMAX+1];
  50.     SEGMENT *seg;
  51.     int n,i,max;
  52.     LVAL p;
  53.  
  54.     /* default the extension */
  55.     if (needsextension(fname)) {
  56.         strcpy(fullname,fname);
  57.         strcat(fullname,".wks");
  58.         fname = fullname;
  59.     }
  60.  
  61.     /* open the output file */
  62.     if ((fp = osbopen(fname,"w")) == NULL)
  63.         return (FALSE);
  64.  
  65.     /* first call the garbage collector to clean up memory */
  66.     gc();
  67.  
  68.     /* write out the pointer to the *obarray* symbol */
  69.     writeptr(cvoptr(obarray));
  70.  
  71.     /* setup the initial file offsets */
  72.     off = foff = (OFFTYPE)2;
  73.  
  74.     /* write out all nodes that are still in use */
  75.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  76.         p = &seg->sg_nodes[0];
  77.         for (n = seg->sg_size; --n >= 0; ++p, off++)
  78.             switch (ntype(p)) {
  79.             case FREE:
  80.                 break;
  81.             case CONS:
  82.             case USTREAM:
  83.                 setoffset();
  84.                 fputc(p->n_type,fp);
  85.                 writeptr(cvoptr(car(p)));
  86.                 writeptr(cvoptr(cdr(p)));
  87.                 foff++;
  88.                 break;
  89.             default:
  90.                 setoffset();
  91.                 writenode(p);
  92.                 break;
  93.         }
  94.     }
  95.  
  96.     /* write the terminator */
  97.     fputc(FREE,fp);
  98.     writeptr((OFFTYPE)0);
  99.  
  100.     /* write out data portion of SYMBOL/VECTOR/OBJECT/STRING/CLOSURE nodes */
  101.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  102.         p = &seg->sg_nodes[0];
  103.         for (n = seg->sg_size; --n >= 0; ++p)
  104.             switch (ntype(p)) {
  105.             case SYMBOL:
  106.             case OBJECT:
  107.             case VECTOR:
  108.             case CLOSURE:
  109. #ifdef STRUCTS
  110.             case STRUCT:
  111. #endif
  112.                 max = getsize(p);
  113.                 for (i = 0; i < max; ++i)
  114.                     writeptr(cvoptr(getelement(p,i)));
  115.                 break;
  116.             case STRING:
  117.                 max = getslength(p);
  118.                 fwrite(getstring(p),1,max,fp);
  119.                 break;
  120.         }
  121.     }
  122.  
  123.     /* close the output file */
  124.     osclose(fp);
  125.  
  126.     /* return successfully */
  127.     return (TRUE);
  128. }
  129.  
  130. /* xlirestore - restore a saved memory image */
  131. int xlirestore(fname)
  132.   char *fname;
  133. {
  134.     extern FUNDEF funtab[];
  135.     char fullname[STRMAX+1];
  136.     int n,i,max,type;
  137.     SEGMENT *seg;
  138.     LVAL p;
  139.  
  140.     /* default the extension */
  141.     if (needsextension(fname)) {
  142.         strcpy(fullname,fname);
  143.         strcat(fullname,".wks");
  144.         fname = fullname;
  145.     }
  146.  
  147.     /* open the file */
  148.     if ((fp = osbopen(fname,"r")) == NULL)
  149.         return (FALSE);
  150.  
  151.     /* free the old memory image */
  152.     freeimage();
  153.  
  154.     /* initialize */
  155.     off = (OFFTYPE)2;
  156.     total = nnodes = nfree = 0L;
  157.     fnodes = NIL;
  158.     segs = lastseg = NULL;
  159.     nsegs = gccalls = 0;
  160.     xlenv = xlfenv = xldenv = s_gchook = s_gcflag = NIL;
  161.     xlstack = xlstkbase + EDEPTH;
  162.     xlfp = xlsp = xlargstkbase;
  163.     *xlsp++ = NIL;
  164.     xlcontext = NULL;
  165.  
  166.     /* create the fixnum segment */
  167.     if ((fixseg = newsegment(SFIXSIZE)) == NULL)
  168.         xlfatal("insufficient memory - fixnum segment");
  169.  
  170.     /* create the character segment */
  171.     if ((charseg = newsegment(CHARSIZE)) == NULL)
  172.         xlfatal("insufficient memory - character segment");
  173.  
  174.     /* read the pointer to the *obarray* symbol */
  175.     obarray = cviptr(readptr());
  176.  
  177.     /* read each node */
  178.     while ((type = fgetc(fp)) >= 0)
  179.         switch (type) {
  180.         case FREE:
  181.             if ((off = readptr()) == (OFFTYPE)0)
  182.                 goto done;
  183.             break;
  184.         case CONS:
  185.         case USTREAM:
  186.             p = cviptr(off);
  187.             p->n_type = type;
  188. #ifndef JGC
  189.             p->n_flags = 0;
  190. #endif
  191.             rplaca(p,cviptr(readptr()));
  192.             rplacd(p,cviptr(readptr()));
  193.             off++;
  194.             break;
  195.         default:
  196.             readnode(type,cviptr(off));
  197.             off++;
  198.             break;
  199.         }
  200. done:
  201.  
  202.     /* read the data portion of SYMBOL/VECTOR/OBJECT/STRING/CLOSURE nodes */
  203.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  204.     p = &seg->sg_nodes[0];
  205.     for (n = seg->sg_size; --n >= 0; ++p)
  206.         switch (ntype(p)) {
  207.         case SYMBOL:
  208.         case OBJECT:
  209.         case VECTOR:
  210.         case CLOSURE:
  211. #ifdef STRUCTS
  212.         case STRUCT:
  213. #endif
  214.             max = getsize(p);
  215.             if ((p->n_vdata = (LVAL *)malloc(max * sizeof(LVAL))) == NULL)
  216.                 xlfatal("insufficient memory - vector");
  217.             total += (long)(max * sizeof(LVAL));
  218.             for (i = 0; i < max; ++i)
  219.                 setelement(p,i,cviptr(readptr()));
  220.             break;
  221.         case STRING:
  222.             max = getslength(p);
  223.             if ((p->n_string = malloc(max)) == NULL)
  224.                 xlfatal("insufficient memory - string");
  225.             total += (long)max;
  226.             fread(getstring(p),1,max,fp);
  227.             break;
  228.         case STREAM:
  229.             setfile(p,NULL);
  230.             break;
  231.         case SUBR:
  232.         case FSUBR:
  233.             p->n_subr = funtab[getoffset(p)].fd_subr;
  234.             break;
  235.         }
  236.     }
  237.  
  238.     /* close the input file */
  239.     osclose(fp);
  240.  
  241.     /* collect to initialize the free space */
  242.     gc();
  243.  
  244.     /* lookup all of the symbols the interpreter uses */
  245.     xlsymbols();
  246.  
  247.     /* return successfully */
  248.     return (TRUE);
  249. }
  250.  
  251. /* freeimage - free the current memory image */
  252. LOCAL VOID freeimage()
  253. {
  254.     SEGMENT *seg,*next;
  255.     FILE *fp;
  256.     LVAL p;
  257.     int n;
  258.  
  259.     /* free the data portion of SYMBOL/VECTOR/OBJECT/STRING nodes */
  260.     for (seg = segs; seg != NULL; seg = next) {
  261.     p = &seg->sg_nodes[0];
  262.     for (n = seg->sg_size; --n >= 0; ++p)
  263.         switch (ntype(p)) {
  264.         case SYMBOL:
  265.         case OBJECT:
  266.         case VECTOR:
  267.         case CLOSURE:
  268. #ifdef STRUCTS
  269.         case STRUCT:
  270. #endif
  271.             if (p->n_vsize)
  272.                 free(p->n_vdata);
  273.             break;
  274.         case STRING:
  275.             if (getslength(p))
  276.                 free(getstring(p));
  277.             break;
  278.         case STREAM:
  279.             if (((fp = getfile(p)) != 0) && 
  280.                 (fp != stdin && fp != stdout && fp != stderr))     /* TAA BUG FIX */
  281.             osclose(fp);
  282.             break;
  283.         }
  284.     next = seg->sg_next;
  285.     free(seg);
  286.     }
  287. }
  288.  
  289. /* setoffset - output a positioning command if nodes have been skipped */
  290. LOCAL VOID setoffset()
  291. {
  292.     if (off != foff) {
  293.         fputc(FREE,fp);
  294.         writeptr(off);
  295.         foff = off;
  296.     }
  297. }
  298.  
  299. /* writenode - write a node to a file */
  300. LOCAL VOID writenode(node)
  301.   LVAL node;
  302. {
  303.     fputc(node->n_type,fp);
  304.     fwrite(&node->n_info, sizeof(union ninfo), 1, fp);
  305.     foff++;
  306. }
  307.  
  308. /* writeptr - write a pointer to a file */
  309. LOCAL VOID writeptr(off)
  310.   OFFTYPE off;
  311. {
  312.     fwrite(&off, sizeof(OFFTYPE), 1, fp);
  313. }
  314.  
  315. /* readnode - read a node */
  316. LOCAL VOID readnode(type,node)
  317.   int type; LVAL node;
  318. {
  319.     node->n_type = type;
  320. #ifndef JGC
  321.     node->n_flags = 0;
  322. #endif
  323.     fread(&node->n_info, sizeof(union ninfo), 1, fp);
  324. }
  325.  
  326. /* readptr - read a pointer */
  327. LOCAL OFFTYPE readptr()
  328. {
  329.     OFFTYPE off;
  330.     fread(&off, sizeof(OFFTYPE), 1, fp);
  331.     return (off);
  332. }
  333.  
  334. /* cviptr - convert a pointer on input */
  335. LOCAL LVAL cviptr(o)
  336.   OFFTYPE o;
  337. {
  338.     OFFTYPE off = (OFFTYPE)2;
  339.     SEGMENT *seg;
  340.  
  341.     /* check for nil */
  342.     if (o == (OFFTYPE)0)
  343.         return ((LVAL)o);
  344.  
  345.     /* compute a pointer for this offset */
  346.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  347.         if (o >= off && o < off + (OFFTYPE)seg->sg_size)
  348.             return (seg->sg_nodes + o - off);
  349.         off += (OFFTYPE)seg->sg_size;
  350.     }
  351.  
  352.     /* create new segments if necessary */
  353.     for (;;) {
  354.  
  355.     /* create the next segment */
  356.         if ((seg = newsegment(anodes)) == NULL)
  357.             xlfatal("insufficient memory - segment");
  358.  
  359.     /* check to see if the offset is in this segment */
  360.         if (o >= off && o < off + (OFFTYPE)seg->sg_size)
  361.             return (seg->sg_nodes + o - off);
  362.         off += (OFFTYPE)seg->sg_size;
  363.     }
  364. }
  365. #ifdef __ZTC__
  366. /* Special version for Zortech C */
  367. /* cvoptr - convert a pointer on output */
  368. LOCAL OFFTYPE cvoptr(p)
  369.   LVAL p;
  370. {
  371.     OFFTYPE off = (OFFTYPE)2;
  372.     SEGMENT *seg;
  373.     OFFTYPE np = CVPTR(p);
  374.     LVAL min1,max1;
  375.     OFFTYPE min,max;
  376.  
  377.     /* check for nil and small fixnums */
  378.     if (p == NIL)
  379.         return ((OFFTYPE)p);
  380.  
  381.     /* compute an offset for this pointer */
  382.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  383.         min1 = &seg->sg_nodes[0];
  384.         max1 = &seg->sg_nodes[seg->sg_size];
  385.         min = CVPTR(min1);
  386.         max = CVPTR(max1);
  387.         if (np >= min  && np < max)
  388.             return (off+ ((np-min)/sizeof(struct node)));
  389.         off += (OFFTYPE)seg->sg_size;
  390.     }
  391.  
  392.     /* pointer not within any segment */
  393.     xlerror("bad pointer found during image save",p);
  394.     return (0);    /* fake out compiler warning */
  395. }
  396. #else
  397. /* cvoptr - convert a pointer on output */
  398. LOCAL OFFTYPE cvoptr(p)
  399.   LVAL p;
  400. {
  401.     OFFTYPE off = (OFFTYPE)2;
  402.     SEGMENT *seg;
  403.     OFFTYPE np = CVPTR(p);
  404.  
  405.     /* check for nil and small fixnums */
  406.     if (p == NIL)
  407.         return ((OFFTYPE)p);
  408.  
  409.     /* compute an offset for this pointer */
  410.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  411.         if (np >= CVPTR(&seg->sg_nodes[0]) &&
  412.             np <  CVPTR(&seg->sg_nodes[seg->sg_size]))
  413.                 return (off+ ((np-CVPTR(seg->sg_nodes))/sizeof(struct node)));
  414.             off += (OFFTYPE)seg->sg_size;
  415.     }
  416.  
  417.     /* pointer not within any segment */
  418.     xlerror("bad pointer found during image save",p);
  419.     return (0);    /* fake out compiler warning */
  420. }
  421. #endif
  422. #endif
  423.  
  424.